home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.002 / GTTTNEST.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  32KB  |  967 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {**********************************}
  12.                     {**       Unit:   GTTTNEST       **}
  13.                     {**********************************}
  14.  
  15. {$S-,R-,V-}
  16. {$IFNDEF DEBUG}
  17.    {$D-}
  18. {$ENDIF}
  19.  
  20. Unit GTTTNEST;
  21.  
  22. {$I GOLDFLAG.INC}
  23.  
  24. INTERFACE
  25.  
  26. Uses CRT, GoldAttr, GoldFast, DOS, GoldWin, GoldKey, GoldStr, GoldHard;
  27.  
  28. const
  29.    MaxLevels = 10;        {maximum number of nested menus - alter if necessary}
  30.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  31.    DontClear    = 0;       {signal to return to same position in menu}
  32.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  33.    RefreshMenu  = 2;       {signal to reload current menu}
  34.    ClearCurrent = 3;       {signal to remove current menu}
  35.    ClearAll     = 4;       {signal to remove all menus}
  36.    Undefined    = 99;      {despatcher has not been assigned}
  37.  
  38. type
  39.    NestKeyProc = procedure(var Ch:char; Code:Integer);
  40.    DespatcherProc = procedure(Var Code: integer; var Finish:byte);
  41.  
  42.    MenuStr = string[MenuStrLength];
  43.  
  44.    NDisplay = record
  45.       X: byte;             {top X coord}
  46.       Y: byte;             {top Y coord}
  47.       LeftSide: boolean;   {does menu start on left or right}
  48.       AllowEsc: boolean;   {can user escape from the top level}
  49.       BoxType: byte;       {single,double etc}
  50.       BoxFCol: byte;       {Border foreground color}
  51.       BoxBCol: byte;       {Border background color}
  52.       CapFCol: byte;       {Capital letter foreground color}
  53.       BacCol: byte;        {menu background color}
  54.       NorFCol: byte;       {normal foreground color}
  55.       LoFCol: byte;        {inactive topic foreground color}
  56.       HiFCol: byte;        {highlighted topic foreground color}
  57.       HiBCol: byte;        {highlighted topic background color}
  58.       LeftChar: char;      {left-hand topic highlight character}
  59.       RightChar: char;     {right-hand topic highlight character}
  60.       Hook: NestKeyProc;   { a procedure called after every key is pressed}
  61.       Despatcher: Despatcherproc;  { the main procedure to execute}
  62.    end;
  63.  
  64.     TopicPtr = ^TopicRecord;
  65.     MenuPtr = ^NestMenu;
  66.  
  67.     TopicRecord = record
  68.        Name: MenuStr;
  69.        Active: boolean;
  70.        HotKey: char;
  71.        RetCode: integer;
  72.        SubMenu: MenuPtr;
  73.        NextTopic: TopicPtr;
  74.     end;
  75.  
  76.     NestMenu = record
  77.        Title: MenuStr;          {title for menu}
  78.        TopicWidth: byte;        {width of topics in menu}
  79.        VisibleLines: word;      {no. topics in box, 0 is DisplayLines - 2}
  80.        FirstTopic: TopicPtr;    {used internally, do not alter}
  81.        TotalTopics: word;       {used internally, do not alter}
  82.     end;
  83.  
  84. var
  85.        Nfatal: boolean;
  86.        NError: integer;
  87.        NTTT: NDisplay;
  88.  
  89. procedure DefaultSettings;
  90. procedure AssignDespatcher(D:DespatcherProc);
  91. procedure InitializeMenu(var Menu:NestMenu; Tit: menuStr; Width: byte;
  92.                              DisplayLines: word);
  93. procedure AddTopic(var Menu:NestMenu; Nam: MenuStr; Activ: boolean;
  94.                        HKey: char; Code: integer; Sub: MenuPtr);
  95. procedure ModifyTopic(var Menu:NestMenu; TopicNo: word; Nam: MenuStr;
  96.                           Activ: boolean; HKey: char; Code: integer;
  97.                           Sub: MenuPtr);
  98. procedure ModifyTopicName(var Menu:NestMenu; TopicNo: word; Nam: MenuStr);
  99. procedure ModifyTopicActive(var Menu:NestMenu; TopicNo: word; Activ: Boolean);
  100. procedure ModifyTopicHotKey(var Menu:NestMenu; TopicNo: word; HKey: char);
  101. procedure ModifyTopicRetCode(var Menu:NestMenu; TopicNo: word; Code: integer);
  102. procedure ModifyTopicSubMenu(var Menu:NestMenu; TopicNo : word; Sub : MenuPtr);
  103. procedure DeleteATopic(var Menu:NestMenu;TopicNo: word);
  104. procedure DeleteAllTopics(var Menu:NestMenu);
  105. procedure ShowNest(var Menu:NestMenu);
  106.  
  107. IMPLEMENTATION
  108.  
  109. var DespatcherAssigned: boolean;
  110.  
  111. procedure NestTTTError(No: byte);
  112. {Updates Nerror and optionally displays error message then halts program}
  113. var Msg: string;
  114. begin
  115.    Nerror := No;
  116.    if Nfatal = true then
  117.    begin
  118.       case No of
  119.          1:  Msg := 'Insufficient memory to add topic';
  120.          2:  Msg := 'Insufficient memory to save screen';
  121.          3:  Msg := 'No active picks in menu';
  122.          4:  Msg := 'Screen was not previously saved cannot restore';
  123.          5:  Msg := 'Too many levels in menu. Change MaxLevels in NestTTT';
  124.          6:  Msg := 'Topic does not exist, cannot modify';
  125.          7:  Msg := 'A user procedure has not been assigned to despatcher';
  126.          else Msg := '?) -- Utterly confused';
  127.       end; {case}
  128.       Msg := 'Fatal Error (NestTTT -- '+Msg;
  129.       Writeln(Msg);
  130.       delay(5000);    {display long enough to read if child process}
  131.       halt;
  132.    end;
  133. end; { NestTTTError }
  134.  
  135. {$F+}
  136. procedure EmptyDespatcher(var Code: integer; var Finish: byte);
  137. {}
  138. begin
  139.    Finish := Undefined;
  140. end; { EmptyDespatcher }
  141.  
  142. procedure NoNestHook(var Ch: char; Code: integer);
  143. {}
  144. begin
  145. end; { NoNestHook }
  146. {$F-}
  147.  
  148. procedure DefaultSettings;
  149. begin
  150.    with NTTT do
  151.    begin
  152.       X := 0;
  153.       Y := 0;
  154.       DespatcherAssigned := false;
  155.       LeftSide := true;
  156.       AllowEsc := true;
  157.       BoxType := 1;
  158.       if ColorScreen then
  159.       begin
  160.          BoxFCol := yellow;
  161.          BoxBCol := blue;
  162.          CapFCol := white;
  163.          BacCol := blue;
  164.          NorFCol := lightgray;
  165.          LoFCol := black;
  166.          HiFCol := white;
  167.          HiBCol := red;
  168.       end else
  169.       begin
  170.          BoxFCol := white;
  171.          BoxBCol := black;
  172.          CapFCol := white;
  173.          BacCol := black;
  174.          NorFCol := lightgray;
  175.          LoFCol := darkgray;
  176.          HiFCol := white;
  177.          HiBCol := black;
  178.       end;
  179.       LeftChar := Chr(16);
  180.       RightChar := Chr(17);
  181. {$IFNDEF VER40}
  182.       Hook := NoNestHook;
  183.       Despatcher := EmptyDespatcher;
  184. {$ELSE}
  185.       NestUserHook := nil;
  186.       NestDespatcher := nil;
  187. {$ENDIF}
  188.    end;  {with}
  189. end;  { DefaultSettings }
  190.  
  191. {$IFNDEF VER40}
  192. procedure AssignDespatcher(D: DespatcherProc);
  193. {}
  194. begin
  195.    NTTT.Despatcher := D;
  196.    DespatcherAssigned := true;
  197. end; { AssignDespatcher }
  198. {$ENDIF}
  199.  
  200. procedure InitializeMenu(var Menu: NestMenu; Tit: menuStr; Width: byte;
  201.                              DisplayLines: word);
  202. {}
  203. begin
  204.    with Menu do
  205.    begin
  206.       Title := Tit;
  207.       TopicWidth := Width;
  208.       VisibleLines := DisplayLines;
  209.       FirstTopic := nil;
  210.       TotalTopics := 0;
  211.    end; {with}
  212. end; { InitializeMenu }
  213.  
  214. procedure AddTopic(var Menu: NestMenu; Nam: MenuStr; Activ: boolean;
  215.                        HKey: char; Code: integer; Sub: MenuPtr);
  216. {Adds a new topic to the menu.}
  217. var TempPtr: TopicPtr;
  218. begin
  219.    if MaxAvail < SizeOf(TempPtr^) then
  220.    begin
  221.       NestTTTError(1);   {not enough memory}
  222.       exit;
  223.    end else
  224.    NError := 0;
  225.    if Menu.FirstTopic = nil then
  226.    begin
  227.       getmem(Menu.FirstTopic,SizeOf(TempPtr^));
  228.       TempPtr := Menu.FirstTopic;
  229.    end else
  230.    begin
  231.       TempPtr := Menu.FirstTopic;          {start at bottom}
  232.       while TempPtr^.NextTopic <> nil do   {loop to unallocated block}
  233.          TempPtr := TempPtr^.NextTopic;
  234.          getmem(TempPtr^.NextTopic,SizeOf(TempPtr^));
  235.       TempPtr := TempPtr^.NextTopic;
  236.    end;
  237.    with TempPtr^ do
  238.    begin
  239.       Name := Nam;
  240.       if (Name = '-') or (Name = '=') then
  241.          Active := false
  242.       else
  243.          Active := Activ;
  244.       HotKey := Hkey;
  245.       RetCode := Code;
  246.       SubMenu := Sub;
  247.       NextTopic := nil;
  248.    end;
  249.    inc(Menu.TotalTopics);
  250. end; { AddTopic }
  251.  
  252. function PointertoTopic(Men:NestMenu;TopicNo:word): TopicPtr;
  253. {returns a pointer to the TopicNo'th entry in menu, or nil
  254. if greater than TotalTopics}
  255. var  W: word;
  256.      TempPtr: TopicPtr;
  257. begin
  258.    with Men do
  259.    begin
  260.       if TopicNo > TotalTopics then
  261.          TempPtr := nil
  262.       else
  263.       begin
  264.          TempPtr := FirstTopic;
  265.          for W := 2 to TopicNo do
  266.              TempPtr := TempPtr^.NextTopic
  267.       end;
  268.    end;
  269.    PointertoTopic := TempPtr;
  270. end; { PointertoTopic }
  271.  
  272. procedure ModifyTopic(var Menu: NestMenu; TopicNo: word; Nam: MenuStr;
  273.                           Activ: boolean; HKey: char; Code: integer;
  274.                           Sub: MenuPtr);
  275. {Changes all the settings for a topic}
  276. var TempPtr: TopicPtr;
  277. begin
  278.    TempPtr := PointerToTopic(Menu,TopicNo);
  279.    if TempPtr = nil then
  280.       NestTTTError(6);
  281.    with TempPtr^ do
  282.    begin
  283.       Name := Nam;
  284.       if (Name = '-') or (Name = '=') then
  285.          Active := false
  286.       else
  287.          Active := Activ;
  288.       HotKey := Hkey;
  289.       RetCode := Code;
  290.       SubMenu := Sub;
  291.    end; {with}
  292. end; { ModifyTopic }
  293.  
  294. procedure ModifyTopicName(var Menu: NestMenu; TopicNo: word; Nam: MenuStr);
  295. {Change title or name of a topic}
  296. var TempPtr: TopicPtr;
  297. begin
  298.    TempPtr := PointerToTopic(Menu,TopicNo);
  299.    if TempPtr = nil then
  300.       NestTTTError(6);
  301.    TempPtr^.Name := Nam;
  302.    if (Nam = '-') or (Nam = '=') then
  303.       TempPtr^.Active := false;
  304. end; { ModifyTopicName }
  305.  
  306. procedure ModifyTopicActive(var Menu: NestMenu; TopicNo: word; Activ: boolean);
  307. {Changes active status of a topic}
  308. var TempPtr: TopicPtr;
  309. begin
  310.    TempPtr := PointerToTopic(Menu,TopicNo);
  311.    if TempPtr = nil then
  312.       NestTTTError(6);
  313.    TempPtr^.Active := Activ;
  314. end; { ModifyTopicActive }
  315.  
  316. procedure ModifyTopicHotKey(var Menu: NestMenu; TopicNo: word; HKey: char);
  317. {Changes Hotkey character of a topic}
  318. var TempPtr: TopicPtr;
  319. begin
  320.    TempPtr := PointerToTopic(Menu,TopicNo);
  321.    if TempPtr = nil then
  322.       NestTTTError(6);
  323.    TempPtr^.HotKey := HKey;
  324. end; { ModifyTopicHotKey }
  325.  
  326. procedure ModifyTopicRetCode(var Menu: NestMenu; TopicNo: word; Code: integer);
  327. {Changes Return code for a topic}
  328. var TempPtr: TopicPtr;
  329. begin
  330.    TempPtr := PointerToTopic(Menu,TopicNo);
  331.    if TempPtr = nil then
  332.       NestTTTError(6);
  333.    TempPtr^.Retcode := Code;
  334. end; { ModifyTopicHotKey }
  335.  
  336. procedure ModifyTopicSubMenu(var Menu: NestMenu; TopicNo: word; Sub: MenuPtr);
  337. {Changes Return code for a topic}
  338. var TempPtr: TopicPtr;
  339. begin
  340.    TempPtr := PointerToTopic(Menu,TopicNo);
  341.    if TempPtr = nil then
  342.       NestTTTError(6);
  343.    TempPtr^.SubMenu := Sub;
  344. end; { ModifyTopicHotKey }
  345.  
  346. procedure DeleteATopic(var Menu: NestMenu; TopicNo: word);
  347. {}
  348. var TempPtrA,TempPtrB: TopicPtr;
  349. begin
  350.    if TopicNo = 1 then
  351.    begin
  352.       if Menu.FirstTopic = nil then
  353.          NestTTTError(6);
  354.       TempPtrA := Menu.FirstTopic^.NextTopic;
  355.       freemem(Menu.FirstTopic,SizeOf(TempPtrA^));
  356.       Menu.FirstTopic := TempPtrA;
  357.    end else
  358.    begin
  359.       TempPtrA := PointerToTopic(Menu,pred(TopicNo));
  360.       if TempPtrA = nil then
  361.          NestTTTError(6);
  362.       TempPtrB := PointerToTopic(Menu,TopicNo);
  363.       if TempPtrB = nil then
  364.          NestTTTError(6);
  365.       TempPtrA^.NextTopic := TempPtrB^.NextTopic;
  366.       freemem(TempPtrB,SizeOf(TempPtrB^));
  367.    end;
  368.    dec(Menu.TotalTopics);
  369. end; { DeleteATopic }
  370.  
  371. procedure DeleteAllTopics(var Menu: NestMenu);
  372. {}
  373. var TempPtrA,TempPtrB: TopicPtr;
  374. begin
  375.    TempPtrA := Menu.FirstTopic;
  376.    while (TempPtrA <> nil) do
  377.    begin
  378.       TempPtrB := TempPtrA^.NextTopic;
  379.       if TempPtrA <> nil then
  380.       begin
  381.          freemem(TempPtrA,SizeOf(TempPtrA^));
  382.          TempPtrA := TempPtrB;
  383.       end;
  384.    end;
  385.    Menu.FirstTopic := nil;
  386. end; { DeleteAllTopics }
  387.  
  388. procedure ShowNest(var Menu: NestMenu);
  389. {}
  390. type
  391.      LevelInfo = record
  392.         Pick: word;
  393.         TheMenu: MenuPtr;     {link to menu}
  394.         X1: integer;           {coords of saved screens}
  395.         Y1: integer;
  396.         X2: integer;
  397.         Y2: integer;
  398.         TopPick: byte;
  399.         HiPick: byte;
  400.         SavedScreen: pointer; {location of saved screen}
  401.      end;
  402. var
  403.      I: word;
  404.      TempPtr: TopicPtr;
  405.      FinCode: byte;
  406.      Nest: array[1..MaxLevels] of LevelInfo;
  407.      CurrentLevel: byte;
  408.      LiveMenu: Nestmenu;
  409.      ChL: char;
  410.      Found,
  411.      Finished: boolean;
  412.  
  413.      function TopicPointer(TopicNo: word): TopicPtr;
  414.      {subfunction}
  415.      begin
  416.         TopicPointer := PointertoTopic(LiveMenu,TopicNo);
  417.      end; { TopicPointer }
  418.  
  419.      procedure ComputeCoords(var LiveMenu: NestMenu);
  420.      {subfunction determines X1,Y1,X2,Y2 for new menu}
  421.      begin
  422.         with Nest[Currentlevel] do
  423.         begin
  424.            if LiveMenu.VisibleLines = 0 then
  425.               LiveMenu.VisibleLines := HardVars.Depth-2;
  426.            if LiveMenu.TotalTopics < LiveMenu.VisibleLines then
  427.               LiveMenu.VisibleLines := LiveMenu.TotalTopics;
  428.            if CurrentLevel = 1 then
  429.            begin
  430.               if NTTT.X = 0 then
  431.               begin
  432.                  if NTTT.LeftSide then
  433.                  begin
  434.                     X1 := 1;
  435.                     X2 := LiveMenu.TopicWidth + 4;
  436.                  end else    {RightSide}
  437.                  begin
  438.                     X2 := 80;
  439.                     X1 := 80 - LiveMenu.TopicWidth - 3;
  440.                  end;
  441.               end else {X not Zero}
  442.               begin
  443.                  if NTTT.LeftSide then
  444.                  begin
  445.                     X1 := NTTT.X;
  446.                     X2 := pred(X1)+LiveMenu.TopicWidth + 4;
  447.                     if X2 > 80 then
  448.                     begin
  449.                        X2 := 80;
  450.                        X1 := X2 - 3 - LiveMenu.TopicWidth;
  451.                     end;
  452.                  end else    {RightSide}
  453.                  begin
  454.                     X2 := NTTT.X;
  455.                     X1 := X2 - LiveMenu.TopicWidth - 3;
  456.                     if X1 < 1 then
  457.                     begin
  458.                        X1 := 1;
  459.                        X2 := X1 +LiveMenu.TopicWidth +3;
  460.                     end;
  461.                  end;
  462.               end;
  463.               if NTTT.Y = 0 then
  464.                  Y1 := 1
  465.               else
  466.                  Y1 := NTTT.Y;
  467.               if LiveMenu.TotalTopics >= LiveMenu.VisibleLines then
  468.                  Y2 := Y1 + succ(LiveMenu.VisibleLines)
  469.               else
  470.                  Y2 := Y1 + succ(LiveMenu.TotalTopics);
  471.               if Y2 > HardVars.Depth then
  472.               begin
  473.                  Y2 := HardVars.Depth;
  474.                  LiveMenu.VisibleLines := Y2 - succ(Y1);
  475.               end;
  476.            end else   {not the first level menu}
  477.            begin
  478.               if NTTT.LeftSide then
  479.               begin
  480.                  X1 := pred(Nest[pred(CurrentLevel)].X2);
  481.                  X2 := X1 + 3 + LiveMenu.TopicWidth;
  482.                  if X2 > 80 then
  483.                  begin
  484.                     X2 := 80;
  485.                     X1 := X2 - 4 - LiveMenu.TopicWidth;
  486.                  end;
  487.               end else   {rightside}
  488.               begin
  489.                  X2 := succ(Nest[pred(CurrentLevel)].X1);
  490.                  X1 := X2 - LiveMenu.TopicWidth - 3;
  491.                  if X1 < 1 then
  492.                  begin
  493.                     X1 := 1;
  494.                     X2 := X1 +LiveMenu.TopicWidth +3;
  495.                  end;
  496.               end;
  497.               Y1 := succ(Nest[Pred(CurrentLevel)].Y1) +
  498.                          Nest[Pred(CurrentLevel)].HiPick -
  499.                          Nest[Pred(CurrentLevel)].TopPick;
  500.               if LiveMenu.TotalTopics >= LiveMenu.VisibleLines then
  501.                  Y2 := succ(Y1) + LiveMenu.VisibleLines
  502.               else
  503.                  Y2 := succ(Y1) + LiveMenu.TotalTopics;
  504.               if Y2 > HardVars.Depth then
  505.               begin
  506.                  Y2 := HardVars.Depth;
  507.                  if Y2 - succ(LiveMenu.VisibleLines) >= 1 then
  508.                     Y1 := Y2 - succ(LiveMenu.VisibleLines)
  509.                  else
  510.                  begin
  511.                     Y1 := 1;
  512.                     LiveMenu.VisibleLines := HardVars.Depth - 2;
  513.                  end;
  514.               end;
  515.            end;
  516.         end; { with }
  517.      end; { ComputeCoords }
  518.  
  519.      procedure SaveScreen;
  520.      {saved part of screen overlayed by menu}
  521.      begin
  522.         with Nest[CurrentLevel] do
  523.         begin
  524.            if MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  525.               NestTTTError(2)
  526.            else
  527.            begin
  528.               getmem(SavedScreen,succ(Y2-Y1)*succ(X2-X1)*2);
  529.               PartSave(X1,Y1,X2,Y2,SavedScreen^);
  530.            end;
  531.         end;
  532.      end; { SaveScreen }
  533.  
  534.      procedure RestoreScreen;
  535.      {saved part of screen overlayed by menu}
  536.      begin
  537.         with Nest[CurrentLevel] do
  538.         begin
  539.            if SavedScreen = nil then
  540.               NestTTTError(4)
  541.            else
  542.            begin
  543.               PartRestore(X1,Y1,X2,Y2,SavedScreen^);
  544.               FreeMem(SavedScreen,succ(Y2-Y1)*succ(X2-X1)*2);
  545.            end;
  546.         end;
  547.      end; { RestoreScreen }
  548.  
  549.      procedure ComputeFirstActivePick;
  550.      {}
  551.      var I : word;
  552.      begin
  553.         With Nest[Currentlevel] do
  554.         begin
  555.            TopPick := 1;
  556.            HiPick := 1;
  557.            while (TopicPointer(HiPick)^.Active = false)
  558.                  and (HiPick < LiveMenu.TotalTopics) do
  559.               inc(HiPick);
  560.            if (TopicPointer(HiPick)^.Active = false) then {no active picks in menu}
  561.            begin
  562.               NestTTTError(3);
  563.               exit;
  564.            end;
  565.            if HiPick > LiveMenu.VisibleLines then
  566.               TopPick := HiPick - pred(LiveMenu.VisibleLines);
  567.         end; { with }
  568.      end; { ComputeFirstActivePick }
  569.  
  570.      procedure ComputeTopicWidth(var Livemenu: NestMenu);
  571.      {}
  572.      var I: word;
  573.          W,Biggest: Byte;
  574.      begin
  575.         Biggest := 0;
  576.         for I := 1 To LiveMenu.TotalTopics do
  577.         begin
  578.            W := length(TopicPointer(I)^.Name);
  579.            if Biggest < W then
  580.               Biggest := W;
  581.         end;
  582.         if Biggest < length(LiveMenu.Title) then
  583.            Biggest := length(LiveMenu.Title);
  584.         LiveMenu.TopicWidth := Biggest;
  585.      end; { ComputeTopicWidth }
  586.  
  587.      procedure WriteTopic(TopicNo:word;Hilight:boolean);
  588.      {}
  589.      var A,Y: byte;
  590.          T: TopicPtr;
  591.      begin
  592.         T := TopicPointer(TopicNo);
  593.         if T = Nil then
  594.            exit;
  595.         if HiLight then
  596.            A := Cattr(NTTT.HiFCol,NTTT.HiBCol)
  597.         else
  598.         begin
  599.            if T^.Active then
  600.               A := Cattr(NTTT.NorFcol,NTTT.BacCol)
  601.            else
  602.               A := Cattr(NTTT.LoFcol,NTTT.BacCol);
  603.         end;
  604.         with Nest[Currentlevel] do
  605.         begin
  606.            Y := succ(Y1) + TopicNo - TopPick;
  607.            if HiLight then
  608.               WriteAT(succ(X1),Y,A,
  609.                       NTTT.LeftChar+
  610.                       PadLeft(T^.Name,LiveMenu.TopicWidth,' ')+
  611.                       NTTT.Rightchar)
  612.            else
  613.            case T^.Name[1] of
  614.               '-': HorizLine(Succ(X1),Pred(X2),Y,Cattr(NTTT.BoxFCol,NTTT.BacCol),1);
  615.               '=': HorizLine(Succ(X1),Pred(X2),Y,Cattr(NTTT.BoxFCol,NTTT.BacCol),1);
  616.               else
  617.               begin
  618.                  WriteAT(succ(X1),Y,A,' '+
  619.                          PadLeft(T^.Name,LiveMenu.TopicWidth,' ')+' ');
  620.                  if (T^.Active) and (FirstCapitalPos(T^.Name) > 0) then
  621.                     WriteAT(succ(X1)+FirstCapitalPos(T^.Name),Y,
  622.                             Cattr(NTTT.CapFCol,NTTT.BacCol),
  623.                             FirstCapital(T^.Name));
  624.               end;
  625.            end; {case}
  626.         end;
  627.      end; { WriteTopic }
  628.  
  629.      procedure DisplayAllTopics;
  630.      {}
  631.      var I : Integer;
  632.      begin
  633.         with Nest[CurrentLevel] do
  634.         begin
  635.            for I := TopPick to TopPick+pred(LiveMenu.VisibleLines) do
  636.                WriteTopic(I,false);
  637.            WriteTopic(HiPick,true);
  638.         end;
  639.      end; { DisplayAllTopics }
  640.  
  641.      procedure DisplayLiveMenu;
  642.      {}
  643.      begin
  644.         with Nest[CurrentLevel] do
  645.         begin
  646.            FBox(X1,Y1,X2,Y2,Cattr(NTTT.BoxFCol,NTTT.BoxBCol),NTTT.BoxType);
  647.            WriteBetween(X1,X2,Y1,Cattr(NTTT.BoxFCol,NTTT.BoxBCol),Livemenu.Title);
  648.         end;
  649.         DisplayAllTopics;
  650.      end; { DisplayLiveMenu }
  651.  
  652.      function NextPickDown(Wrap:boolean): word;
  653.      {}
  654.      var P: word;
  655.      begin
  656.         with Nest[CurrentLevel] do
  657.         begin
  658.            P := HiPick;
  659.            if P < LiveMenu.TotalTopics then
  660.            begin
  661.               inc(P);
  662.               while (P < LiveMenu.TotalTopics)
  663.               and (TopicPointer(P)^.Active = false) do
  664.                  inc(P);
  665.               if TopicPointer(P)^.Active = false then
  666.               begin
  667.                  if Wrap and (LiveMenu.TotalTopics <= LiveMenu.VisibleLines) then
  668.                  begin
  669.                     P := TopPick;  {scroll to top}
  670.                     while (P < LiveMenu.TotalTopics)
  671.                     and (TopicPointer(P)^.Active = false) do
  672.                        inc(P);
  673.                  end else
  674.                  P := Hipick;
  675.               end;
  676.            end else     {P is at bottom of menu}
  677.            begin
  678.               if Wrap and (LiveMenu.TotalTopics <= LiveMenu.VisibleLines) then
  679.                  P := TopPick;  {scroll to top}
  680.               while (P < LiveMenu.TotalTopics)
  681.               and (TopicPointer(P)^.Active = false) do
  682.                  inc(P);
  683.            end;
  684.            NextPickDown := P;
  685.         end; {with}
  686.      end; { NextPickDown }
  687.  
  688.      function NextPickUp(Wrap:boolean): word;
  689.      {}
  690.      var P: word;
  691.      begin
  692.         with Nest[CurrentLevel] do
  693.         begin
  694.            P := HiPick;
  695.            if P > 1 then
  696.            begin
  697.               dec(P);
  698.               while (P > 1)
  699.               and (TopicPointer(P)^.Active = false) do
  700.                  dec(P);
  701.               if TopicPointer(P)^.Active = false then
  702.               begin
  703.                  if Wrap and (LiveMenu.TotalTopics <= LiveMenu.VisibleLines) then
  704.                  begin
  705.                     P := LiveMenu.TotalTopics;  {scroll to top}
  706.                     while (P > 1) and (TopicPointer(P)^.Active = false) do
  707.                          dec(P);
  708.                  end else
  709.                  P := Hipick;
  710.               end;
  711.            end else     {P is at top of menu}
  712.            begin
  713.               if Wrap and (LiveMenu.TotalTopics <= LiveMenu.VisibleLines) then
  714.               begin
  715.                  P := LiveMenu.TotalTopics;  {scroll to top}
  716.                  while (P > 1) and (TopicPointer(P)^.Active = false) do
  717.                     dec(P);
  718.               end;
  719.            end;
  720.            NextPickUp := P;
  721.         end; {with}
  722.      end; { NextPickUp }
  723.  
  724.      procedure LoadMenu(var NewMenu: NestMenu);
  725.      {}
  726.      begin
  727.         if CurrentLevel < MaxLevels then
  728.            inc(CurrentLevel)
  729.         else
  730.            NestTTTError(5);
  731.         Nest[CurrentLevel].TheMenu := @NewMenu;
  732.         LiveMenu := NewMenu;
  733.         if LiveMenu.TopicWidth <= 0 then
  734.         begin
  735.            ComputeTopicWidth(LiveMenu);
  736.            NewMenu.TopicWidth := LiveMenu.TopicWidth;
  737.         end;
  738.         ComputeCoords(LiveMenu);
  739.         ComputeCoords(NewMenu);
  740.         ComputeFirstActivePick;
  741.         SaveScreen;
  742.         DisplayLiveMenu;
  743.      end; { LoadMenu }
  744.  
  745.      procedure ExecuteCommand;
  746.      {}
  747.      var TempPtr: TopicPtr;
  748.          Code: integer;
  749.      begin
  750.         TempPtr := TopicPointer(Nest[CurrentLevel].HiPick);
  751.         if TempPtr^.SubMenu <> nil then
  752.            LoadMenu(TempPtr^.SubMenu^)
  753.         else
  754.         begin
  755.            Code := TempPtr^.Retcode;
  756. {$IFNDEF VER40}
  757.            NTTT.Despatcher(Code,Fincode);
  758. {$ELSE}
  759.            if NestDespatcher <> Nil then
  760.               CallFromNestDespatcher(Code,Fincode)
  761.            else
  762.            Fincode := Undefined;
  763. {$ENDIF}
  764.            case Fincode of
  765.               Undefined    : NestTTTError(7);
  766.               DontClear    : ;
  767.               RefreshTopic : WriteTopic(Nest[CurrentLevel].HiPick,True);
  768.               RefreshMenu  : DisplayAllTopics;
  769.               ClearCurrent : begin
  770.                                 RestoreScreen;
  771.                                 if CurrentLevel > 1 then
  772.                                 begin
  773.                                    dec(CurrentLevel);
  774.                                    LiveMenu := Nest[CurrentLevel].TheMenu^;
  775.                                 end else
  776.                                 Finished := true;
  777.                              end;
  778.               ClearAll     : begin
  779.                                 while CurrentLevel > 0 do
  780.                                 begin
  781.                                    RestoreScreen;
  782.                                    dec(CurrentLevel);
  783.                                    LiveMenu := Nest[CurrentLevel].TheMenu^;
  784.                                 end;
  785.                                 Finished := true;
  786.                              end;
  787.            end; {case}
  788.         end;
  789.      end; { ExecuteCommand }
  790.  
  791.      procedure DisplayMore;
  792.      {}
  793.      var A: byte;
  794.      begin
  795.         if LiveMenu.VisibleLines < Livemenu.TotalTopics then
  796.         with Nest[CurrentLevel] do
  797.         begin
  798.            A := Cattr(NTTT.CapFCol,NTTT.BoxBCol);
  799.            if TopPick > 1 then
  800.               WriteAT(X2,Succ(Y1),A,chr(24))
  801.            else
  802.               VertLine(X2,Succ(Y1),Succ(Y1),Cattr(NTTT.BoxFcol,NTTT.BoxBCol),Nttt.Boxtype);
  803.            if TopPick + Pred(LiveMenu.VisibleLines) < LiveMenu.TotalTopics then
  804.               WriteAT(X2,Pred(Y2),A,chr(25))
  805.            else
  806.               VertLine(X2,Pred(Y2),Pred(Y2),Cattr(NTTT.BoxFcol,NTTT.BoxBCol),Nttt.Boxtype);
  807.         end;
  808.      end; { DisplayMore }
  809.  
  810. begin
  811.    Currentlevel := 0;
  812. {$IFNDEF VER40}
  813.    if not DespatcherAssigned then
  814.       NestTTTError(7);
  815. {$ELSE}
  816.    if NestDespatcher = nil then
  817.       NestTTTError(7);
  818. {$ENDIF}
  819.    LoadMenu(Menu);
  820.    Finished := False;
  821.    repeat
  822.       DisplayMore;
  823.       ChL := GetKey;
  824. {$IFNDEF VER40}
  825.       NTTT.Hook(ChL,TopicPointer(Nest[CurrentLevel].HiPick)^.RetCode);
  826. {$ELSE}
  827.       if NestUserHook <> Nil then
  828.          CallFromNestUserHook(ChL,TopicPointer(Nest[CurrentLevel].HiPick)^.RetCode);
  829. {$ENDIF}
  830.       if ChL <> #0 then
  831.          case upcase(ChL) of
  832.          #132,                               {right button}
  833.          #027    : if CurrentLevel = 1 then
  834.                    begin
  835.                       if NTTT.AllowEsc then
  836.                       begin
  837.                          RestoreScreen;
  838.                          Finished := true;
  839.                       end;
  840.                    end else
  841.                    begin
  842.                       RestoreScreen;
  843.                       dec(CurrentLevel);
  844.                       LiveMenu := Nest[CurrentLevel].TheMenu^;
  845.                    end;
  846.          #133,                                       {Mouse left button}
  847.          #13     : begin                             {Enter}
  848.                       ExecuteCommand;
  849.                    end;
  850.          ' ',
  851.          #129,                                       {Mouse down}
  852.          #208    : with Nest[CurrentLevel] do       {Down arrow}
  853.                    begin
  854.                       WriteTopic(HiPick,False);
  855.                       HiPick := NextPickDown(ChL = #208);
  856.                       if HiPick >= TopPick + LiveMenu.VisibleLines then
  857.                       begin
  858.                          TopPick := HiPick - pred(LiveMenu.VisibleLines);
  859.                          DisplayAllTopics;
  860.                       end;
  861.                       WriteTopic(HiPick,True);
  862.                    end;
  863.          #128,                                       {Mouse up}
  864.          #200    : with Nest[CurrentLevel] do       {Up arrow}
  865.                    begin
  866.                       WriteTopic(HiPick,False);
  867.                       HiPick := NextPickUp(ChL = #200);
  868.                       if HiPick < TopPick then
  869.                       begin
  870.                          TopPick := HiPick;
  871.                          DisplayAllTopics;
  872.                       end;
  873.                       WriteTopic(HiPick,True);
  874.                    end;
  875.          #199    : if Nest[CurrentLevel].HiPick <> 1 then      {Home}
  876.                    begin
  877.                       ComputeFirstActivePick;
  878.                       DisplayAllTopics;
  879.                    end;
  880.          #207    : With Nest[CurrentLevel] do
  881.                    begin
  882.                       WriteTopic(HiPick,False);
  883.                       HiPick := LiveMenu.TotalTopics;
  884.                       while (HiPick > 0)
  885.                             and (TopicPointer(HiPick)^.Active =false) do
  886.                           dec(HiPick);
  887.                       if HiPick >= TopPick + LiveMenu.VisibleLines then
  888.                       begin
  889.                          TopPick := HiPick - pred(LiveMenu.VisibleLines);
  890.                          DisplayAllTopics;
  891.                       end;
  892.                       WriteTopic(HiPick,True);
  893.                    end;
  894.          'A'..'Z': with Nest[CurrentLevel] do
  895.                    begin
  896.                       Found := false;
  897.                       I := HiPick;
  898.                       repeat
  899.                          TempPtr := TopicPointer(I);
  900.                          if (FirstCapital(TempPtr^.Name) = upcase(ChL))
  901.                             and (TempPtr^.Active) then
  902.                          begin
  903.                             Found := true;
  904.                             WriteTopic(HiPick,false);
  905.                             HiPick := I;
  906.                             if HiPick >= TopPick + LiveMenu.VisibleLines then
  907.                             begin
  908.                                TopPick := HiPick - pred(LiveMenu.VisibleLines);
  909.                                DisplayAllTopics;
  910.                             end else
  911.                             if HiPick < TopPick  then
  912.                             begin
  913.                                TopPick := HiPick;
  914.                                DisplayAllTopics;
  915.                             end;
  916.                             WriteTopic(HiPick,true);
  917.                          end else
  918.                          if I = LiveMenu.TotalTopics then
  919.                             I := 1
  920.                          else
  921.                             inc(I);
  922.                       until Found or (I = HiPick);
  923.                       if Found then
  924.                          ExecuteCommand;
  925.                    end;
  926.          else   {see if the user pressed a special key}
  927.          with Nest[CurrentLevel] do
  928.          begin
  929.             Found := false;
  930.             I := HiPick;
  931.             repeat
  932.                TempPtr := TopicPointer(I);
  933.                if ((TempPtr^.Hotkey) = ChL)
  934.                   and (TempPtr^.Active) then
  935.                begin
  936.                   Found := true;
  937.                   WriteTopic(HiPick,false);
  938.                   HiPick := I;
  939.                   if HiPick >= TopPick + LiveMenu.VisibleLines then
  940.                   begin
  941.                      TopPick := HiPick - pred(LiveMenu.VisibleLines);
  942.                      DisplayAllTopics;
  943.                   end else
  944.                   if HiPick < TopPick  then
  945.                   begin
  946.                      TopPick := HiPick;
  947.                      DisplayAllTopics;
  948.                   end;
  949.                   WriteTopic(HiPick,true);
  950.                end else
  951.                if I = LiveMenu.TotalTopics then
  952.                   I := 1
  953.                else
  954.                   inc(I);
  955.             until Found or (I = HiPick);
  956.             if Found then
  957.                ExecuteCommand;
  958.          end;
  959.       end; {case}
  960.    until Finished;
  961. end; { ShowNest }
  962.  
  963. begin
  964.    DefaultSettings;
  965.    NFatal := true;
  966. end.
  967.